home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / surfmodl / surfm203.arc / SURFSRC.ARC / SURFACE.INC < prev    next >
Text File  |  1988-02-01  |  4KB  |  112 lines
  1. procedure SURFACE;
  2.  
  3. { Make a surface model drawing of the object }
  4. var Node:                      integer;       { node # }
  5.     Surf:                      integer;       { surface # }
  6.     Cont:                      char;
  7.     Shade:                     real;          { shade of surface }
  8.     Node1:                     integer;       { 1st node of surface }
  9.     Count:                     integer;       { # vertices in shadow }
  10.     Vert:                      integer;       { vertex # }
  11. {$ifndef BIGMEM}
  12.     Shades: nodearray;
  13.       { shade at each node }
  14.     Surfmin, Surfmax: surfaces;
  15.       { surface minimum & maximum (Ztran) }
  16. {$endif}
  17. label ABORTTEXT,                              { text-mode abort }
  18.       ABORTGRPH;                              { graphics-mode abort }
  19.  
  20. begin
  21. {$ifdef BIGMEM}
  22. with ptra^ do with ptrb^ do with ptrc^ do
  23. with ptrd^ do with ptre^ do with ptrf^ do
  24. with ptrh^ do with ptri^ do with ptrj^ do
  25. with ptrk^ do
  26. begin
  27. {$endif}
  28.   if (checkey) then goto ABORTTEXT;
  29. {$ifndef NOSHADOW}
  30.   if (Shadowing) then
  31.     shadows (Shades)
  32.   else
  33. {$else}
  34.   if (Shadowing) then
  35.     writeln ('Error: Shadows not implemented in this version')
  36.   else
  37. {$endif}
  38.     for Node := 1 to Nnodes do
  39.       Shades[Node] := 0.0;
  40.  
  41.   if (Viewchanged) or (Shadowing) then begin
  42.     menumsg ('Transforming to 2-D...');
  43.     if (checkey) then goto ABORTTEXT;
  44. { Transform from 3-D to 2-D coordinates }
  45.     setorigin;
  46.     for Node := 1 to Nnodes do
  47.       perspect (Xworld[Node], Yworld[Node], Zworld[Node],
  48.                 Xtran[Node],  Ytran[Node],  Ztran[Node]);
  49.  
  50.     if (checkey) then goto ABORTTEXT;
  51. { Set plotting limits and normalize transformed coords to screen coords }
  52.     perspect (Xfocal, Yfocal, Zfocal, Xfotran, Yfotran, Zfotran);
  53.     if (not setnormal (Xfotran, Yfotran, XYmax)) then begin
  54.       menumsg ('Warning: Focal point outside data limits.');
  55.       writeln;
  56.       write   ('  Press any key ...');
  57.       while (not keypressed) do;
  58.     { Erase the previous message }
  59.       menumsg ('');
  60.       writeln;
  61.       write ('                          ');
  62.     end;
  63.  
  64.     if (checkey) then goto ABORTTEXT;
  65. { Normalize all the nodes }
  66.     for Node := 1 to Nnodes do
  67.       normalize (Xtran[Node], Ytran[Node], Xfotran, Yfotran, XYmax);
  68.  
  69.     if (checkey) then goto ABORTTEXT;
  70.     menumsg ('Sorting surfaces...');
  71.     minmax (Surfmin, Surfmax, Nsurf);
  72.     shelsurf (Surfmin, Surfmax, Nsurf);
  73.     Viewchanged := FALSE;
  74.   end; { if Viewchanged }
  75.  
  76.   setshade;                            { Setup for shading calculations }
  77.   setgmode;
  78.   for Surf := 1 to Nsurf do begin
  79.     Count := 0;
  80.     if (Shadowing) then begin
  81.       for Vert := 1 to Nvert[Surf] do
  82.         if (Shades[konnec (Surf, Vert)] < 0.0) then
  83.           Count := Count + 1;
  84.     end;
  85. { In a shadow if any vertex of the surface is in shadow }
  86.     if (Count < 1) then begin
  87.       { Not in shadow }
  88.       Node1 := konnec (Surf, 1);
  89.       if (Nsides = 2) then begin
  90.         { do the secondary surface first, if desired }
  91.         Shade := shading (Surf, 2);
  92.         if (Shade >= 0.0) then
  93.           fillsurf (Surf, Color[Matl[Surf]], Shade);
  94.       end;
  95.       Shade := shading (Surf, 1);
  96.       if (Shade >= 0.0) then
  97.         fillsurf (Surf, Color[Matl[Surf]], Shade);
  98.     end else
  99.       fillsurf (Surf, Color[Matl[Surf]], Ambient[Matl[Surf]]);
  100.     if (grafstat) then goto ABORTGRPH;
  101.   end; { for Surf }
  102.   drawaxes (Xfotran, Yfotran, XYmax);
  103. { Wait for user keypress to continue }
  104.   continue;
  105.   ABORTGRPH:
  106.   exgraphic;
  107.   ABORTTEXT:
  108. {$ifdef BIGMEM}
  109. end; {with}
  110. {$endif}
  111. end; {procedure SURFACE }
  112.